#' Format a `doseGrid` for Printing

#'

#' @param grid (`numeric`)\cr the dose grid

#' @param units (`character`)\cr The units in which the values in `doseGrid` are

#' @param fmt (`character`)\cr The format used to display values in `doseGrid`.

#' If `NA`, grid values are not pre-formatted

#' @param ... not used at present

#' measured.  Appended to each value in `doseGrid` when `knit_print`ed.  The

#' default, `NA`, omits the units.

#' @return A character string containing the formatted dose grid.  If the grid

#' is `c(1, 2, 3)` and `units` is `"mg"`, the returned value is `"1 mg, 2 mg and 3 mg"`.

#' @keywords internal

h_get_formatted_dosegrid <- function(grid, units = NA, fmt = NA, ...) {

  )

  } else {

  }

      ),

    ),

  )

}

#' Set Column Headers in Custom `knit_print` Methods

#'

#' This is a helper method used `knit_print` for `crmPack` classes.

#'

#' @param x (`ANY`)\cr object that will be printed

#' @param param (`list`)\cr A list of the `...` parameters passed to `knit_print`

#' @param summarise (`flag`)\cr Is the object to be summarised (default) or listed?

#' @return A character vector of column names.

#' @noRd

h_knit_print_set_headers <- function(x, param, summarise, ...) {

}

#' @description `r lifecycle::badge("experimental")`

#' @rdname knit_print_set_headers

#' @noRd

h_knit_print_set_headers.GeneralData <- function(x, param, summarise, ...) {

    } else {

    }

  }

}

#' @description `r lifecycle::badge("experimental")`

#' @rdname knit_print_set_headers

#' @noRd

h_knit_print_set_headers.DataDA <- function(x, param, summarise, ...) {

      )

    } else {

    }

  }

}

#' @description `r lifecycle::badge("experimental")`

#' @rdname knit_print_set_headers

#' @noRd

h_knit_print_set_headers.DataGrouped <- function(x, param, summarise, ...) {

    } else {

      )

    }

  }

}

#' @description `r lifecycle::badge("experimental")`

#' @rdname knit_print_set_headers

#' @noRd

h_knit_print_set_headers.DataParts <- function(x, param, summarise, ...) {

    } else {

    }

  }

}

#' @description `r lifecycle::badge("experimental")`

#' @noRd

h_knit_print_set_headers.DataOrdinal <- function(x, param, summarise, ...) {

      )

    } else {

    }

  }

}

#' @description `r lifecycle::badge("experimental")`

#' @rdname knit_print_set_headers

#' @noRd

h_knit_print_set_headers.DataDual <- function(x, param, summarise, ...) {

    } else {

    }

  }

}

#' Select Columns to Print in Custom `knit_print` Methods

#'

#' This is a helper method used `knit_print` for `crmPack` classes.

#'

#' @param x (`ANY`)\cr object that will be printed

#' @param ... Not used at present.

#' @return A tidied version of `x`, containing only the selected columns.

#' @noRd

h_knit_print_select_columns <- function(x, ...) {

}

#' @description `r lifecycle::badge("experimental")`

#' @rdname knit_print_select_columns

#' @noRd

h_knit_print_select_columns.GeneralData <- function(x, ...) {

}

#' @description `r lifecycle::badge("experimental")`

#' @rdname knit_print_select_columns

#' @noRd

h_knit_print_select_columns.Data <- function(x, ...) {

}

#' @description `r lifecycle::badge("experimental")`

#' @rdname knit_print_select_columns

#' @noRd

h_knit_print_select_columns.DataParts <- function(x, ...) {

}

#' @description `r lifecycle::badge("experimental")`

#' @rdname knit_print_select_columns

#' @noRd

h_knit_print_select_columns.DataOrdinal <- function(x, ...) {

}

#' @description `r lifecycle::badge("experimental")`

#' @rdname knit_print_select_columns

#' @noRd

h_knit_print_select_columns.DataDA <- function(x, param, summarise, ...) {

}

#' @description `r lifecycle::badge("experimental")`

#' @rdname knit_print_select_columns

#' @noRd

h_knit_print_select_columns.DataGrouped <- function(x, param, summarise, ...) {

}

#' @description `r lifecycle::badge("experimental")`

#' @rdname knit_print_select_columns

#' @noRd

h_knit_print_select_columns.DataDual <- function(x, param, summarise, ...) {

}

#' Summarise a `Data` Object by Dose or Cohort for Display in Custom `knit_print` Methods

#'

#' This is a helper method used `knit_print` for `crmPack` classes.

#'

#' @param x (`ANY`)\cr object that will be printed

#' @param full_grid (`flag`)\cr Should the full grid be included or only those

#' doses with at least one evaluable participant?

#' @param ... Not used at present.

#' @return A tibble containing the summarised data

#' @noRd

h_knit_print_summarise <- function(x, summarise, full_grid, ...) {

}

#' @description `r lifecycle::badge("experimental")`

#' @rdname knit_print_summarise

#' @noRd

h_knit_print_summarise.GeneralData <- function(x, summarise, full_grid, ...) {

    )

      )

  }

}

#' @description `r lifecycle::badge("experimental")`

#' @rdname knit_print_summarise

#' @noRd

h_knit_print_summarise.DataOrdinal <- function(x, summarise, full_grid, ...) {

    )

      )

    )

    # Create a list whose names are the columns in which we need to replace NAs

    # and whose values are 0

    # Expand the tibble and do the replacement

  }

}

#' @description `r lifecycle::badge("experimental")`

#' @rdname knit_print_summarise

#' @noRd

h_knit_print_summarise.DataGrouped <- function(x, summarise, full_grid, ...) {

    )

    ) %>%

  }

}

#' Print a `GeneralData` Object in a Markdown or Quarto Chunk

#'

#' @param label (`character`)\cr How to describe the participants in the trial.

#' See Usage Notes below.

#' @param full_grid (`flag`)\cr Should the full dose grid appear in the output table

#' or simply those doses for whom at least one evaluable participant is available?

#' Ignored unless `summarise == "dose"`.

#' @param summarise (`character`)\cr How to summarise the observed data.  The default,

#' `"none"`, lists observed data at the participant level.  `"dose"` presents

#' participant counts by dose and `"cohort"` by cohort.

#' @param summarize (`character`)\cr Synonym for `summarise`

#' @param format_func (`function`)\cr The function used to format the participant table.

#' The default applies no formatting.  Obvious alternatives include `kableExtra::kable_styling`.

#' @param ... passed to [knitr::kable()]

#' @section Usage Notes:

#' `label` describes the trial's participants.

#'

#' It should be a character vector of length 1 or 2.  If of length 2, the first

#' element describes a single participant and the second describes all other

#' situations.  If of length 1, the character `s` is appended to the value

#' when the number of participants is not 1.

#' The default values of `col.names` and `caption` vary depending on the summary

#' requested. The default values can be overridden by passing `col.names` and

#' `caption` in the function call.

#'

#' @inheritParams h_get_formatted_dosegrid

#' @export

#' @method knit_print GeneralData

#' @rdname knit_print

knit_print.GeneralData <- function(

  x,

  ...,

  asis = TRUE,

  label = c("participant", "participants"),

  full_grid = FALSE,

  summarise = c("none", "dose", "cohort"),

  summarize = summarise,

  units = NA,

  format_func = h_knit_format_func

) {

  # Validate

  }

  # Initialise

  # Execute

    }

  } else {

    }

  }

  } else {

  }

        ...

      ),

      ""

    ),

  )

  }

}

#' Used to obtain expected format.

#' @keywords internal

h_knit_format_func <- function(x) {

  )

}

#' @export

#' @method knit_print DataParts

#' @rdname knit_print

knit_print.DataParts <- function(

  x,

  ...,

  asis = TRUE,

  label = c("participant", "participants"),

  full_grid = FALSE,

  summarise = c("none", "dose", "cohort"),

  summarize = summarise,

  units = NA,

  format_func = h_knit_format_func

) {

    ),

  )

  }

}

#' @include McmcOptions-class.R

#' @include Model-methods.R

#' @include fromQuantiles.R

NULL

# size ----

## Samples ----

#' @describeIn size get the number of MCMC samples from `Samples` object.

#' @aliases size-Samples

#'

#' @export

#' @example examples/Samples-methods-size.R

#'

setMethod(

  f = "size",

  signature = signature(object = "Samples"),

  definition = function(object, ...) {

  }

)

# names ----

## Samples ----

#' The Names of the Sampled Parameters

#'

#' @description `r lifecycle::badge("stable")`

#'

#' A method that returns names of the parameters that are sampled.

#'

#' @param x (`Samples`)\cr object with samples.

#'

#' @aliases names-Samples

#' @export

#' @example examples/Samples-methods-names.R

#'

setMethod(

  f = "names",

  signature = signature(x = "Samples"),

  definition = function(x) {

  }

)

## --------------------------------------------------

## Extract certain parameter from "Samples" object to produce

## plots with "ggmcmc" package

## --------------------------------------------------

# The next line is required to suppress the message "Creating a generic function

# for ‘get’ from package ‘base’ in package ‘crmPack’" on package load.

# See https://github.com/openpharma/crmPack/issues/723

setGeneric("get")

#' Get specific parameter samples and produce a data.frame

#'

#' Here you have to specify with \code{pos} which

#' parameter you would like to extract from the \code{\linkS4class{Samples}}

#' object

#'

#' @param x the \code{\linkS4class{Samples}} object

#' @param pos the name of the parameter

#' @param envir for vectorial parameters, you can give the indices of the

#' elements you would like to extract. If \code{NULL}, the whole vector samples

#' will be returned

#' @param mode not used

#' @param inherits not used

#'

#' @return the data frame suitable for use with \code{\link[ggmcmc]{ggmcmc}}

#'

#' @example examples/Sample-methods-get.R

#' @export

#' @keywords methods

setMethod(

  "get",

  signature = signature(

    x = "Samples",

    pos = "character",

    envir = "ANY",

    mode = "ANY",

    inherits = "ANY"

  ),

  def = function(x, pos, envir = NULL, mode = NULL, inherits = NULL) {

    ## check the parameter name

    ## get the samples for this parameter

    ## this can be either a vector or a matrix

    ## how many parameters do we have?

    ## what are the names of all parameter

    ## elements?

      } else {

      }

    ## in case we have a vector parameter

      ## what are the indices to be returned?

        } else {

        }

      ## subset the data matrix and par names appropriately

      ## and also reduce the number of parameters

    }

    ## now we can build

    )

    ## add the attributes

    )

  }

)

## --------------------------------------------------

## Get fitted curves from Samples

## --------------------------------------------------

#' Fit method for the Samples class

#'

#' Note this new generic function is necessary because the \code{\link{fitted}}

#' function only allows the first argument \code{object} to appear in the

#' signature. But we need also other arguments in the signature.

#'

#' @param object the \code{\linkS4class{Samples}} object

#' @param model the \code{\linkS4class{GeneralModel}} object

#' @param data the \code{\linkS4class{Data}} object

#' @param \dots passed down to the [prob()] method.

#' @return the data frame with required information (see method details)

#'

#' @export

#' @keywords methods

setGeneric(

  "fit",

  def = function(object, model, data, ...) {

    ## there should be no default method,

    ## therefore just forward to next method!

  },

  valueClass = "data.frame"

)

## --------------------------------------------------

## Get fitted dose-tox curve from Samples

## --------------------------------------------------

#' @param points at which dose levels is the fit requested? default is the dose

#' grid

#' @param quantiles the quantiles to be calculated (default: 0.025 and

#' 0.975)

#' @param middle the function for computing the middle point. Default:

#' \code{\link{mean}}

#'

#' @describeIn fit This method returns a data frame with dose, middle, lower

#' and upper quantiles for the dose-toxicity curve

#' @example examples/Sample-methods-fit.R

#'

setMethod(

  "fit",

  signature = signature(

    object = "Samples",

    model = "GeneralModel",

    data = "Data"

  ),

  def = function(

    object,

    model,

    data,

    points = data@doseGrid,

    quantiles = c(0.025, 0.975),

    middle = mean,

    ...

  ) {

    ## some checks

    ## first we have to get samples from the dose-tox

    ## curve at the dose grid points.

    )

    ## evaluate the probs, for all samples.

      ## Now we want to evaluate for the

      ## following dose:

        ...

      )

    }

    ## extract middle curve

    ## extract quantiles

    ## now create the data frame

    )

  }

)

## --------------------------------------------------

## Get fitted dose-tox and dose-biomarker curves from Samples

## --------------------------------------------------

#' @describeIn fit This method returns a data frame with dose, and middle,

#' lower and upper quantiles, for both the dose-tox and dose-biomarker (suffix

#' "Biomarker") curves, for all grid points (Note that currently only the grid

#' points can be used, because the DualEndpointRW models only allow that)

#'

#' @example examples/Sample-methods-fit-DualEndpoint.R

setMethod(

  "fit",

  signature = signature(

    object = "Samples",

    model = "DualEndpoint",

    data = "DataDual"

  ),

  def = function(

    object,

    model,

    data,

    quantiles = c(0.025, 0.975),

    middle = mean,

    ...

  ) {

    ## some checks

    ## first obtain the dose-tox curve results from the parent method

      ...

    )

    ## now obtain the dose-biomarker results

    ## get the biomarker level samples

    ## at the dose grid points.

    )

    ## extract middle curve

    ## extract quantiles

    ## now create the data frame

    )

    ## return both, pasted together

  }

)

## --------------------------------------------------

## Approximate posterior with (log) normal distribution

## --------------------------------------------------

#' Approximate posterior with (log) normal distribution

#'

#' To reproduce the resultant approximate model in the future exactly, include

#' \code{seed = xxxx} in the call to `approximate`.

#'

#' @param object the \code{\linkS4class{Samples}} object

#' @param model the \code{\linkS4class{GeneralModel}} object

#' @param data the \code{\linkS4class{Data}} object

#' @param \dots additional arguments (see methods)

#' @return a `list` containing the approximation model and, if requested, a

#' `ggplot2` object containing a graphical representation of the fitted model

#'

#' @export

#' @keywords methods

setGeneric(

  "approximate",

  def = function(object, model, data, ...) {

    ## there should be no default method,

    ## therefore just forward to next method!

  },

  valueClass = "list"

)

##' @param points optional parameter, which gives the dose values at which

##' the approximation should rely on (default: 5 values equally spaced from

##' minimum to maximum of the dose grid)

##' @param refDose the reference dose to be used (default: median of

##' \code{points})

##' @param logNormal use the log-normal prior? (not default) otherwise, the

##' normal prior for the logistic regression coefficients is used

##' @param verbose be verbose (progress statements)? (default)

##' @param create_plot add a `ggplot2` object to the return value (default)

##'

##' @describeIn approximate Here the \dots argument can transport additional arguments for

##' \code{\link{Quantiles2LogisticNormal}}, e.g. in order to control the

##' approximation quality, etc.

##'

##' @example examples/Sample-methods-approximate.R

setMethod(

  "approximate",

  signature = signature(object = "Samples"),

  def = function(

    object,

    model,

    data,

    points = seq(

      from = min(data@doseGrid),

      to = max(data@doseGrid),

      length = 5L

    ),

    refDose = median(points),

    logNormal = FALSE,

    verbose = TRUE,

    create_plot = TRUE,

    ...

  ) {

    # Validation

    ## get the required quantiles at these dose levels:

    )

    ## get better starting values if it is already a logistic normal

    ## model

      )

      )

        )

      )

      )

    } else {

    }

    ## run the approx function

      ...

    )

        ) %>%

        ) %>%

          )

        ) +

        ) +

        ) +

        ) +

    }

  }

)

## --------------------------------------------------

## Plot dose-tox fit from a model

## --------------------------------------------------

#' Plotting dose-toxicity model fits

#'

#' @param x the \code{\linkS4class{Samples}} object

#' @param y the \code{\linkS4class{GeneralModel}} object

#' @param data the \code{\linkS4class{Data}} object

#' @param xlab the x axis label

#' @param ylab the y axis label

#' @param showLegend should the legend be shown? (default)

#' @param \dots not used

#' @return This returns the \code{\link[ggplot2]{ggplot}}

#' object for the dose-toxicity model fit

#'

#' @example examples/Sample-methods-plot.R

#' @export

setMethod(

  "plot",

  signature = signature(

    x = "Samples",

    y = "GeneralModel"

  ),

  def = function(

    x,

    y,

    data,

    ...,

    xlab = "Dose level",

    ylab = "Probability of DLT [%]",

    showLegend = TRUE

  ) {

    ## check args

    ## get the fit

      ...

    )

    ## make the plot

              ),

              )

            ),

            )

          )

        )

      )

        ),

      ) +

      )

        ),

      )

  }

)

## --------------------------------------------------

## Special method for dual endpoint model

## --------------------------------------------------

#' Plotting dose-toxicity and dose-biomarker model fits

#'

#' When we have the dual endpoint model,

#' also the dose-biomarker fit is shown in the plot

#'

#' @param x the \code{\linkS4class{Samples}} object

#' @param y the \code{\linkS4class{DualEndpoint}} object

#' @param data the \code{\linkS4class{DataDual}} object

#' @param extrapolate should the biomarker fit be extrapolated to the whole

#' dose grid? (default)

#' @param showLegend should the legend be shown? (not default)

#' @param \dots additional arguments for the parent method

#' \code{\link{plot,Samples,GeneralModel-method}}

#' @return This returns the \code{\link[ggplot2]{ggplot}}

#' object with the dose-toxicity and dose-biomarker model fits

#'

#' @example examples/Sample-methods-plot-DualEndpoint.R

#' @export

setMethod(

  "plot",

  signature = signature(

    x = "Samples",

    y = "DualEndpoint"

  ),

  def = function(x, y, data, extrapolate = TRUE, showLegend = FALSE, ...) {

    ## call the superclass method, to get the toxicity plot

    ## only look at these dose levels for the plot:

      } else {

      }

    ## get the plot data for the biomarker plot

    ## extract mean curve

    ## extract quantiles

    ## now create the data frame

    )

    ## make the second plot

              ),

              )

            ),

            )

          )

        )

      )

        ),

      ) +

      )

        ),

      )

    ## arrange both plots side by side

  }

)

## -------------------------------------------------------------------------------------

## Get fitted dose-tox curve from Samples for 'LogisticIndepBeta' model class

## ------------------------------------------------------------------------------------

#' @describeIn fit This method return a data frame with dose, middle lower and upper quantiles

#' for the dose-DLE curve using DLE samples for \dQuote{LogisticIndepBeta} model class

#' @example examples/Samples-method-fitDLE.R

setMethod(

  "fit",

  signature = signature(

    object = "Samples",

    model = "LogisticIndepBeta",

    data = "Data"

  ),

  def = function(

    object,

    model,

    data,

    points = data@doseGrid,

    quantiles = c(0.025, 0.975),

    middle = mean,

    ...

  ) {

    ## some checks

    ## first we have to get samples from the dose-tox

    ## curve at the dose grid points.

    )

    ## evaluate the probs, for all samples.

      ## Now we want to evaluate for the

      ## following dose:

      )

    }

    ## extract middle curve

    ## extract quantiles

    ## now create the data frame

    )

  }

)

## -------------------------------------------------------------------------------------

## Get fitted dose-efficacy curve from Samples for 'Effloglog' model class

## ------------------------------------------------------------------------------------

#' @describeIn fit This method returns a data frame with dose, middle, lower, upper quantiles for

#' the dose-efficacy curve using efficacy samples for \dQuote{Effloglog} model class

#' @example examples/Samples-method-fitEff.R

setMethod(

  "fit",

  signature = signature(

    object = "Samples",

    model = "Effloglog",

    data = "DataDual"

  ),

  def = function(

    object,

    model,

    data,

    points = data@doseGrid,

    quantiles = c(0.025, 0.975),

    middle = mean,

    ...

  ) {

    ## some checks

    ## first we have to get samples from the dose-tox

    ## curve at the dose grid points.

    )

    ## evaluate the probs, for all samples.

      ## Now we want to evaluate for the

      ## following dose:

      )

    }

    ## extract middle curve

    ## extract quantiles

    ## now create the data frame

    )

  }

)

## ==========================================================================================

## --------------------------------------------------------------------

## Get fitted dose-efficacy based on the Efficacy Flexible model

## -------------------------------------------------------------

#' @describeIn fit This method returns a data frame with dose, middle, lower and upper

#' quantiles for the dose-efficacy curve using efficacy samples for \dQuote{EffFlexi}

#' model class

#' @example examples/Samples-method-fitEffFlexi.R

setMethod(

  "fit",

  signature = signature(

    object = "Samples",

    model = "EffFlexi",

    data = "DataDual"

  ),

  def = function(

    object,

    model,

    data,

    points = data@doseGrid,

    quantiles = c(0.025, 0.975),

    middle = mean,

    ...

  ) {

    ## some checks

    ## first we have to get samples from the dose-tox

    ## curve at the dose grid points.

    )

    ## evaluate the probs, for all samples.

      ## Now we want to evaluate for the

      ## following dose:

      )

    }

    ## extract middle curve

    ## extract quantiles

    ## now create the data frame

    )

  }

)

#' @describeIn fit This method returns a data frame with dose, middle, lower

#' and upper quantiles for the dose-efficacy curve using efficacy samples

#' for the \dQuote{LogisticLogNormalOrdinal} model class

#' @example examples/Sample-methods-fit-LogisticLogNormalOrdinal.R

setMethod(

  "fit",

  signature = signature(

    object = "Samples",

    model = "LogisticLogNormalOrdinal",

    data = "DataOrdinal"

  ),

  def = function(

    object,

    model,

    data,

    points = data@doseGrid,

    quantiles = c(0.025, 0.975),

    middle = mean,

    ...

  ) {

    # Validation

    # Begin

    # Get samples from the dose-tox curve at the dose grid points.

    )

    # Evaluate the probs, for all samples.

      # Now we want to evaluate for the following dose:

        ...

      )

    }

    # Extract middle curve

    # Extract quantiles

    # Create the data frame...

    )

  }

)

## ==============================================================

## ----------------------------------------------------------------

## Get fitted values at all dose levels from gain samples

## -----------------------------------------------------------------

#' Get the fitted values for the gain values at all dose levels based on

#' a given pseudo DLE model, DLE sample, a pseudo efficacy model, a Efficacy sample

#' and data. This method returns a data frame with dose, middle, lower and upper quantiles

#' of the gain value samples

#'

#' @param DLEmodel the DLE pseudo model of \code{\linkS4class{ModelTox}} class object

#' @param DLEsamples the DLE samples of \code{\linkS4class{Samples}} class object

#' @param Effmodel the efficacy pseudo model of \code{\linkS4class{ModelEff}} class object

#' @param Effsamples the efficacy samples of \code{\linkS4class{Samples}} class object

#' @param data the data input of \code{\linkS4class{DataDual}} class object

#' @param \dots additional arguments for methods

#'

#' @export

#' @keywords methods

#' @example examples/Samples-method-fitGain.R

setGeneric(

  "fitGain",

  def = function(DLEmodel, DLEsamples, Effmodel, Effsamples, data, ...) {

    ## there should be no default method,

    ## therefore just forward to next method!

  },

  valueClass = "data.frame"

)

#' @describeIn fitGain This method returns a data frame with dose, middle, lower, upper quantiles for

#' the gain values obtained given the DLE and the efficacy samples

#' @param points at which dose levels is the fit requested? default is the dose

#' grid

#' @param quantiles the quantiles to be calculated (default: 0.025 and

#' 0.975)

#' @param middle the function for computing the middle point. Default:

#' \code{\link{mean}}

#' @example examples/Samples-method-fitGain.R

setMethod(

  "fitGain",

  signature = signature(

    DLEmodel = "ModelTox",

    DLEsamples = "Samples",

    Effmodel = "ModelEff",

    Effsamples = "Samples",

    data = "DataDual"

  ),

  def = function(

    DLEmodel,

    DLEsamples,

    Effmodel,

    Effsamples,

    data,

    points = data@doseGrid,

    quantiles = c(0.025, 0.975),

    middle = mean,

    ...

  ) {

    ## some checks

    ## first we have to get samples from the gain

    ## at the dose grid points.

    )

    ## evaluate the probs, for all gain samples.

      ## Now we want to evaluate for the

      ## following dose:

      )

    }

    ## extract middle curve

    ## extract quantiles

    ## now create the data frame